home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
clipper
/
rlib20.zip
/
RL_PDOWN.PRG
< prev
next >
Wrap
Text File
|
1989-02-18
|
15KB
|
460 lines
* Function..: PDOWNINIT
* Author....: Richard Low
* Syntax....: PDOWNINIT( row, columns, options, items, starts, prompts,;
* promptrow, colors, altkeys, exit )
*
* Notes.....: Mandatory function to initialize PDOWNMENU for operation.
* Optional parameters are not required, but if you wish to skip
* an optional parameter, you must pass a dummy value. The best
* dummy value to use is a null string '' (set up a memvar named
* dummy where dummy = '').
*
* Parameters: row - NUMERIC row for top of Pull Down Menu to appear.
* columns - ARRAY of column numbers for each top level option.
* options - ARRAY of top level menu option choices.
* items - ARRAY of pulled down menu items.
* starts - ARRAY of starting element numbers.
* prompts - Optional ARRAY corresponding menu item messages.
* promptrow - Optional NUMERIC row on which these messages appear.
* colors - Optional ARRAY of colors to use for the top Bar and
* pull down Box menus.
*
* color[1] - Option & message displays
* color[2] - Menu selection bars
* color[3] - Pull-down menu box ACTIVE color
* color[4] - Pull-down menu box IN-ACTIVE color
* color[5] - Pull-down menu option after selection
* color[6] - Menu bar option after selection
*
* altkeys - Optional ARRAY of alternate select keys for each menu.
* exit - Optional LOGICAL indicating if escape will exit menu.
*
* Returns...: True if initialization sucessful, False if parameters error.
*
FUNCTION PDOWNINIT
PARAMETERS prow, pcols, pmenus, pitems, pstarts, pprompts, promptrow,;
p_colors, paltkeys, pexit
IF PCOUNT() = 0
*-- if no parameters, release PUBLIC arrays to reclaim memory
RELEASE rl_pd, pd_counts, pd_altkeys, pd_bottoms, pd_rights
RETURN (.T.)
ENDIF
*-- make sure that all the required parameters are the correct type
IF TYPE('prow') + TYPE('pcols') + TYPE('pmenus') +;
TYPE('pitems') + TYPE('pstarts') != 'NAAAA'
RETURN (.F.)
ENDIF
*-- the number of columns, top level options, starting array element
*-- numbers, and menu item counts must all be the same
IF .NOT. ( LEN(pcols) = LEN(pmenus) .AND. LEN(pcols) = LEN(pstarts) )
RETURN (.F.)
ENDIF
*-- there must be more than one menu (get real)
IF LEN(pcols) < 2
RETURN (.F.)
ENDIF
last_menu = LEN(pmenus)
PUBLIC pd_counts[last_menu], pd_altkeys[last_menu]
PUBLIC pd_bottoms[last_menu], pd_rights[last_menu]
*-- fill in menu item counts based on start numbers
*-- can't start at 1 because of computational algorithm
pd_counts[1] = pstarts[2] - 1
FOR x = 2 TO last_menu - 1
*-- count of options in this menu equal next start number minus this start
pd_counts[x] = pstarts[x+1] - pstarts[x]
NEXT x
*-- number of items in last menu is equal to length of array - starting # + 1
pd_counts[ last_menu ] = LEN(pitems) - pstarts[ last_menu ] + 1
*-- copy the altkeys array if it exists
IF TYPE('paltkeys') = 'A'
ACOPY( paltkeys, pd_altkeys )
ELSE
*-- otherwise fill it with nulls
AFILL( pd_altkeys, '' )
ENDIF
AFILL( pd_bottoms, 0 )
AFILL( pd_rights, 0 )
*-- make configuration array public
PUBLIC rl_pd[15]
rl_pd[ 1] = LEN(pmenus) && N - number of menus (used for offset)
rl_pd[ 2] = '' && C - main menu direct select keys
rl_pd[ 3] = IF(TYPE('pbox')='C', pbox, '┌─┐│┘─└│') && C - boxing string
rl_pd[ 4] = SETCOLOR() && save incoming color
*-- use <color array> if it is an array AND it has at least 5 elements
IF IF( TYPE('p_colors') = 'A', IF(LEN(p_colors) >= 5, .T., .F.) , .F. )
rl_pd[ 6] = p_colors[1] && display color
rl_pd[ 7] = p_colors[2] && menu bar color
rl_pd[ 8] = p_colors[3] && active pull down menu box color
rl_pd[ 9] = p_colors[4] && pull down menu box border after exit
rl_pd[10] = p_colors[5] && pull down menu selected option color
rl_pd[ 5] = p_colors[6] && top bar menu selected option color
ELSE
rl_pd[ 6] = rl_pd[4]
rl_pd[ 7] = GETPARM(2, rl_pd[4])
rl_pd[ 8] = BRIGHT(rl_pd[4])
rl_pd[ 9] = rl_pd[4]
rl_pd[10] = rl_pd[8]
rl_pd[ 5] = rl_pd[8]
ENDIF
*-- window coordinates and buffer
rl_pd[11] = prow && N - <maxtop> (top row for main menu)
rl_pd[12] = pcols[1] && N - <maxleft>
rl_pd[13] = 0 && N - <maxbottom>
rl_pd[14] = 0 && N - <maxright>
rl_pd[15] = '' && C - window to hold screen
*-- display bar menu options and build a list of first letter pick keys
*-- and store coordinates for later fast access, and determine maximum
*-- bottom and right coordinates
xjunk = ''
SETCOLOR(rl_pd[6])
@ prow,0 && clear option line in that color
FOR x = 1 TO LEN(pmenus)
@ prow,pcols[x] SAY pmenus[x]
xjunk = xjunk + SUBSTR( LTRIM(pmenus[x]),1,1 ) && build list of direct pick keys
pd_bottoms[x] = prow + pd_counts[x] + 2 && bottom coordinate for this menu
pd_rights[x] = pcols[x] + LEN(pitems[pstarts[x]]) + 1 && right coordinate for this menu
rl_pd[13] = MAX( rl_pd[13], pd_bottoms[x] )
rl_pd[14] = MAX( rl_pd[14], pd_rights[x] )
*-- fill direct select strings with default first letters for each menu
yjunk = ''
FOR y = 1 TO pd_counts[x]
yjunk = yjunk + SUBSTR(LTRIM(pitems[pstarts[x]+y-1]),1,1)
NEXT y
*-- now add to list passed as parameter, if any
pd_altkeys[x] = yjunk + pd_altkeys[x]
NEXT x
*-- set color back to way it was
SETCOLOR(rl_pd[4])
*-- main menu direct and alternate select keys
rl_pd[2] = xjunk
*-- save screen that was painted with top menu options
rl_pd[15] = SAVESCREEN(rl_pd[11],rl_pd[12],rl_pd[13],rl_pd[14])
RETURN (.T.)
*****************************************************************************
* Function..: PDOWNMENU
* Syntax....: PDOWNMENU( @menu, @item, menus, items, columns, starts;
* [, prompts [, exit ] ] )
*
* Notes.....: Pull down menu operation AFTER initialized with PDOWNINIT(...)
* All but the last two parameters are required! If the <prompts>
* are not used, but <exit> is, pass a dummy parameter for <prompts>
*
* Parameters: @menu - pointer to NUMERIC indicating starting top menu option
* @item - pointer to NUMERIC starting menu item (if any) 0 = stay in top
* menus - ARRAY of top level menu option choices.
* items - ARRAY of pulled down menu items.
* columns - ARRAY of column numbers for each top level option.
* starts - ARRAY of starting element numbers.
* prompts - Optional ARRAY corresponding menu item messages.
* exit - Optional LOGICAL indicating if escape will exit.
* Default is True.
*
* Returns...:
*
*
*
*****************************************************************************
FUNCTION PDOWNMENU
PARAMETERS pullmenu, pullitem, pmenus, pitems, pcols, pstarts, pprompts, pexit
PRIVATE fc_incolor, fc_display, fc_menubar, fc_box_on, fc_box_off,;
fc_selitem, fc_selmenu
*-- verify parameters and types
IF TYPE('pullmenu') + TYPE('pullitem') + TYPE('pmenus') +;
TYPE('pitems') + TYPE('pstarts') + TYPE('pcols') != 'NNAAAA'
RETURN 0
ENDIF
prmts_on = IF( TYPE('pprompts') = 'A', .T., .F. ) && if prompts being displayed
prmt_row = IF( TYPE('prmtrow') = 'N', prmtrow, 24 ) && row for prompt messages
pexit = IF( TYPE('pexit') = 'L', pexit, .T. )
*-- retrieve and store colors